home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / PATHSET.SEQ < prev    next >
Text File  |  1988-06-30  |  2KB  |  48 lines
  1. \ PATHSET.SEQ   Words used to set the path of a file.   by Tom Zimmer
  2.  
  3.    0 constant flhndl            \ plugged later
  4.  
  5. : ?drive.extract ( handle --- drive-value )
  6.                 dup >nam 1+ c@ ascii : =
  7.                 if      dup >r >nam c@ bl or 96 -
  8.                         r@ count 2- >r dup 2+ swap r> cmove
  9.                         r@ c@ 2- r@ c! r> count + off
  10.                 else    drop 0 25 bdos 1+ then    ;
  11.  
  12. : ?drive.prepend ( drive-value handle --- )
  13.                 over 0=
  14.                 if      2drop
  15.                 else    dup >r count >r dup 2+ r> cmove>
  16.                         64 + r@ >nam c! ascii : r@ >nam 1+ c!
  17.                         r@ c@ 2+ r> c!
  18.                 then    ;
  19.  
  20. handle pathhndl
  21.  
  22. : prepend.path  ( handle --- f1 )
  23.                 pathhndl clr-hcb
  24.                 dup =: flhndl ?drive.extract >r
  25.                 flhndl >nam c@ ascii \ =
  26.                 if r> flhndl ?drive.prepend 0 exit then
  27.                 ascii \ pathhndl 1+ c! 64 pathhndl c!
  28.                 pathhndl 2+ r@ pdos ?dup
  29.                 if r>drop exit then
  30.                 pathhndl 1+ 64 0   \ determine path length
  31.                 do      dup i + c@ 0= if i pathhndl c! leave then
  32.                 loop    drop pathhndl c@ 1 >
  33.                 if      ascii \ pathhndl count + c! pathhndl c@ 1+ pathhndl c!
  34.                 then  flhndl c@ pathhndl c@ + 62 >
  35.                 if      r> r> 2drop true exit
  36.                 then
  37.                 flhndl 1+ pathhndl c@ over + flhndl c@ cmove>
  38.                 pathhndl count flhndl 1+ swap cmove
  39.                 pathhndl c@ flhndl c@ + flhndl c!
  40.                 r> flhndl ?drive.prepend
  41.                 0 flhndl count + c! 0 ;
  42.  
  43. ' PREPEND.PATH IS PATHSET
  44.  
  45. handle viewpath         viewpath prepend.path drop
  46.  
  47.  
  48.